home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / pars7.exe / D3FGRAF.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-12  |  6KB  |  167 lines
  1. program d3fgraf;
  2. {$M 30000,1024,655360}
  3. {This displays 3d-graphs of functions of two variables x and y that
  4.  can be entered by the user. You give it the function string and the
  5.  x,y-window bordered by xmin,xmax,ymin,ymax, and it draws you the
  6.  graph in the graphics mode it detects. It does detect vesa, but
  7.  does not use the highest mode to save some time and to keep your
  8.  eyes from being damaged by the 8x8 font. You can rotate, zoom in
  9.  an out of a display.}
  10.  
  11. uses dos,crt,pars7,graph,grafpack,realtype;
  12.  
  13. const enter=#13; esc=#27; functionkey=#0;
  14.       Uparrow='H'; Downarrow='P';
  15.       leftarrow='K'; rightarrow='M';
  16.       greater='>'; less='<';
  17.       Updown=''; rightleft=chr(29);
  18. var s:string; xmin,xmax,ymin,ymax,fmin,fmax,x,y,r,rcenter,rright,rfront,
  19.                deltax,deltay:float;
  20.      i,j,grid:integer;  ans: char;
  21.      error,firsttime:boolean;
  22.      myfunc:PParse;
  23.  
  24. procedure wait;
  25. var ans:char;
  26. begin
  27.   repeat until keypressed;
  28.   ans:=readkey;
  29.   if ans=functionkey then ans:=readkey;
  30. end;
  31.  
  32. procedure getkey(var ans:char);
  33. begin
  34.   repeat until keypressed;
  35.   ans:=readkey;
  36.   if ans=functionkey then ans:=readkey;
  37. end;
  38.  
  39. begin
  40.   initgraphic('D:\BP\BGI');  {Put you own BGI-path here}
  41.   leavegraphic;
  42.   repeat
  43.     error:=false;
  44.     write('f(x,y) = ');readln(s); writeln;
  45.     myfunc:=New(PParse,init(s,true,error));
  46.     if error then begin
  47.       writeln('Can''t understand that term.');
  48.       myfunc:=nil end
  49.     else
  50.     begin
  51.       firsttime:=true;
  52.       repeat
  53.         if firsttime then
  54.         begin
  55.           write('xmin =  '); readln(xmin);
  56.           write('xmax =  '); readln(xmax);
  57.           write('ymin =  '); readln(ymin);
  58.           write('ymax =  '); readln(ymax);
  59.           write('gridsize (number of meshpoints in either x or y direction) = ');
  60.           readln(grid);
  61.           fmin:=100000000.0; fmax:=-1000000000.0;
  62.           for i:=0 to 80 do
  63.           for j:=0 to 80 do
  64.           begin
  65.             myfunc^.f(xmin+i*(xmax-xmin)/80,ymin+j*(ymax-ymin)/80,0,r);
  66.             fmin:=min(r,fmin);
  67.             fmax:=max(r,fmax);
  68.           end;
  69.           r:=(fmax-fmin)/20;
  70.           if r=0 then r:=0.01;
  71.           fmax:=fmax+r;
  72.           fmin:=fmin-r;
  73.           entergraphic;
  74.           setwindow(2,2,22);
  75.           viewdist:=6;xwrot:=30;zwrot:=60;
  76.           setd3world(xmin,ymin,fmin,xmax,ymax,fmax,viewdist,xwrot,zwrot);
  77.           gotoxy(3,1);  write('f(x,y) = '+s);
  78.           gotoxy(60,3); write('X-Y-window:');
  79.           gotoxy(60,4); write(xmin:10:4,ymin:10:4);
  80.           gotoxy(60,5); write(xmax:10:4,ymax:10:4);
  81.           gotoxy(60,6); write('Min and Max of f:');
  82.           gotoxy(61,7); write(fmin:10:4,fmax:10:4);
  83.         end;
  84.         clearviewport;
  85.         rectangle(0,0,xw2glb-xw1glb,yw2glb-yw1glb);
  86.         drawd3axes('x','y','z');
  87.         if 0>=xmin then if 0<=xmax then if 0>=ymin then if 0<=ymax then
  88.         d3line(0,0,fmin,0,0,fmax);
  89.         if 0>=xmin then if 0<=xmax then if 0>=fmin then if 0<=fmax then
  90.         d3line(0,ymin,0,0,ymax,0);
  91.         if 0>=fmin then if 0<=fmax then if 0>=ymin then if 0<=ymax then
  92.         d3line(xmin,0,0,xmax,0,0);
  93.         deltax:=(xmax-xmin)/grid;
  94.         deltay:=(ymax-ymin)/grid;
  95.         x:=xmin;
  96.         for i:=0 to grid do
  97.         begin
  98.           y:=ymin;
  99.           myfunc^.f(x,y,0,rcenter);
  100.           for j:=1 to grid do
  101.           begin
  102.             myfunc^.f(x,y+deltay,0,rright);
  103.             myfunc^.f(x+deltax,y,0,rfront);
  104.             d3line(x,y,rcenter,x,y+deltay,rright);
  105.             d3line(x,y,rcenter,x+deltax,y,rfront);
  106.             rcenter:=rright; y:=y+deltay;
  107.           end;
  108.           x:=x+deltax;
  109.         end;
  110.         gotoxy(2,25);
  111.                        write('R: Rotate      W: New Window    F: New Function   Esc: Exit');
  112.         getkey(ans);
  113.         if upcase(ans)='R' then
  114.         begin
  115.           gotoxy(2,25);
  116.           write(updown,rightleft,': Rotate around the world    <>: Zoom       Enter: Draw ');
  117.           clearviewport;
  118.           drawd3axes('x','y','z');
  119.           if 0>=xmin then if 0<=xmax then if 0>=ymin then if 0<=ymax then
  120.           d3line(0,0,fmin,0,0,fmax);
  121.           if 0>=xmin then if 0<=xmax then if 0>=fmin then if 0<=fmax then
  122.           d3line(0,ymin,0,0,ymax,0);
  123.           if 0>=fmin then if 0<=fmax then if 0>=ymin then if 0<=ymax then
  124.           d3line(xmin,0,0,xmax,0,0);
  125.           repeat
  126.             getkey(ans);
  127.             setcolor(0);
  128.             drawd3axes('x','y','z');
  129.             if 0>=xmin then if 0<=xmax then if 0>=ymin then if 0<=ymax then
  130.             d3line(0,0,fmin,0,0,fmax);
  131.             if 0>=xmin then if 0<=xmax then if 0>=fmin then if 0<=fmax then
  132.             d3line(0,ymin,0,0,ymax,0);
  133.             if 0>=fmin then if 0<=fmax then if 0>=ymin then if 0<=ymax then
  134.             d3line(xmin,0,0,xmax,0,0);
  135.             if ans=uparrow then rotatez(-1);
  136.             if ans=downarrow then rotatez(1);
  137.             if ans=leftarrow then rotatex(-1);
  138.             if ans=rightarrow then rotatex(1);
  139.             if ans=less then zoomin;
  140.             if ans=greater then zoomout;
  141.             setcolor(getmaxcolor);
  142.             drawd3axes('x','y','z');
  143.             if 0>=xmin then if 0<=xmax then if 0>=ymin then if 0<=ymax then
  144.             d3line(0,0,fmin,0,0,fmax);
  145.             if 0>=xmin then if 0<=xmax then if 0>=fmin then if 0<=fmax then
  146.             d3line(0,ymin,0,0,ymax,0);
  147.             if 0>=fmin then if 0<=fmax then if 0>=ymin then if 0<=ymax then
  148.             d3line(xmin,0,0,xmax,0,0);
  149.           until ans=enter;
  150.           firsttime:=false;
  151.         end;
  152.         if upcase(ans)='W' then begin leavegraphic; firsttime:=true; end;
  153.       until (ans=esc) or (upcase(ans)='F');
  154.       leavegraphic;
  155.     end;
  156.     if myfunc<>nil then dispose(myfunc,done);
  157.     firsttime:=true;
  158.   until ans=esc;
  159.   if vesaglb then
  160.   begin
  161.     entergraphic;
  162.     setgraphmode(1);
  163.     leavegraphic;
  164.   end;
  165.   closegraph;
  166. end.
  167.